home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / strings_extra < prev    next >
Encoding:
Text File  |  1991-10-24  |  3.2 KB  |  116 lines
  1. \  9/15/86 mdh -- included phils " and 0" ... " works like $" in compile mode
  2. \                 but also useful in interpret mode as it leaves the string
  3. \                 at pad, and is not wrecked by subsequent INTERPRET's...
  4. \                 0" is much the same, but builds a null-terminated string,
  5. \                 which is what the DOS requires (1st text addr).
  6. \
  7. \ MOD: PLB 7/29/88 Added 0STRING to support include files.
  8. \      Added $>0 0>HERE etc.
  9. \ MOD: PLB 1/19/89 Fixed $>0
  10. \ 00001 PLB 10/1/91 Added $ROM TEXTROM 
  11.  
  12. : " ( <word> -- addr , generate string )
  13.       ascii " STATE @
  14.       IF    COMPILE ($")  $,  ( Put string into dictionary. )
  15.       ELSE  lword   pad $move
  16. ( Copy string to pad, safer than HERE. )
  17.             pad
  18.       THEN
  19. ; IMMEDIATE
  20.  
  21.  
  22. .NEED +null
  23.  \ +NULL simply adds a null to the end.  (Make sure there is room!)
  24. : +NULL  ( $adr -- )
  25.     count + 0 swap c!
  26. ;
  27. .THEN
  28.  
  29. : 0" ( <word> -- addr , generate null terminated string for 'C')
  30. \ !!!!!!!!!!   RETURNS ADDRESS OF TEXT CHAR...COUNT IS 1-   !!!!!!!!!!!!!!
  31. \ mdh ... this is the way dos always wants it.
  32.       ascii " STATE @
  33.       IF    COMPILE ($")  here >r    $,  ( Put string into dictionary. )
  34.             r@ count +   0 over c! ( NUL terminate. ) 
  35.             1 and 0=    ( fix DP, is either perfect or 1 too low )
  36.             IF 2 allot  ( but can't allot just 1! )
  37.             THEN r@ c@ 1+ r> c!      ( Account for NUL )
  38.             compile 1+
  39.       ELSE  lword   pad 1- $move
  40. ( Copy string to pad, safer than HERE. )
  41.             0  pad 1- count +  c!
  42.             pad
  43.       THEN
  44. ; IMMEDIATE
  45.  
  46. : $APPEND ( sourceadr srccnt destcntadr -- , append ADDR CNT to $ADDR )
  47.   dup >r dup c@ >r      ( sadr scnt dcadr -- )  \ save orig cnt and addr
  48.   2dup swap r + swap c! ( sadr scnt dcadr -- )  \ install new cnt
  49.   1+ r> +  swap move    ( -- )
  50.   bl  r> dup c@ 1+ + c!
  51. ;
  52.  
  53.  
  54. : 0COUNT ( 0$string -- addr count , COUNT NUL Terminated string )
  55.     dup 1- 
  56.     BEGIN 1+ dup c@ 0=
  57.     UNTIL
  58.     over -
  59. ;
  60.  
  61. : $>0  ( $string -- 0string , convert in place , don't do twice!)
  62.     dup>r
  63.     dup count ( -- a a+1 c )
  64.     >r swap r@ ( -- a+1 a c ) ( -r- a c )
  65.     cmove  ( move characters down )
  66.     0 r> r> + c!
  67. ;
  68.  
  69. : 0>HERE  ( 0string -- , move string to here for compiling )
  70.     0count 1+ ( -- a c . include NUL in count )
  71.     here 1+ swap ( -- a h+1 c )
  72.     dup>r move
  73.     r> dup here c!
  74.     1+ allot align
  75. ;
  76.  
  77. : 0COMPILE ( 0string -- , compile a 'C' string into dict )
  78.     state @
  79.     IF  compile ($") 0>here compile 1+
  80.     THEN
  81. ;
  82.  
  83. \ This can be used in include files or other throw away segments.
  84. : 0STRING  ( 0string <name> -- , inline string constant )
  85.     CREATE  ( 0string -- )
  86.         0>here immediate
  87.     DOES> 1+ 0compile
  88. ;
  89.  
  90.  
  91. \ Text Array Utilities
  92. : ($ROM)  ( index address -- $string )
  93.     ( -- index address )
  94.     swap 0
  95.     DO dup c@ 1+ + even-up
  96.     LOOP
  97. ;
  98.  
  99. : $ROM ( packed array of strings, unalterable )
  100.     CREATE ( <name> -- )
  101.     DOES> ( index -- $string )  ($rom)
  102. ;
  103.  
  104. : TEXTROM ( packed array of strings, unalterable )
  105.     CREATE ( <name> -- )
  106.     DOES> ( index -- address count )  ($rom) count
  107. ;
  108.  
  109. 0 .IF
  110. \ Here is an example of defining a $ROM
  111. $ROM MY-STRINGS ," Open" ," Close" ," Save" ," Create Thing"
  112. 2 MY-STRINGS COUNT TYPE  ( would print "Save")
  113. \ Don't over index!
  114. .THEN
  115.  
  116.